home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 016a / drivex0.zip / DRVDEMO.PAS < prev   
Pascal/Delphi Source File  |  1991-11-01  |  10KB  |  266 lines
  1. (******************************************************************************)
  2. (*                              PROGRAM DRVDEMO                               *)
  3. (*                                                                            *)
  4. (*                               Version:  1.01                               *)
  5. (*                                                                            *)
  6. (*                  Copyright (C) 1991 by NativSoft Computing                 *)
  7. (*                                                                            *)
  8. (*                              1155 College Ave                              *)
  9. (*                              Adrian, MI 49221                              *)
  10. (*                               (517) 265-6080                               *)
  11. (*                              CIS [71160,1045]                              *)
  12. (*                                                                            *)
  13. (*                             ALL RIGHTS RESERVED                            *)
  14. (******************************************************************************)
  15.  
  16. (******************************************************************************)
  17. (*      Written by:  Charles B. Little, Ph.D.                                 *)
  18. (*         Version:  1.01                                                     *)
  19. (*   Revision Date:  1 November 1991                                          *)
  20. (*         Purpose:  To demonstrate the use of unit DRIVExx to obtain         *)
  21. (*                   important information about disk drives.                 *)
  22. (******************************************************************************)
  23.  
  24. {$S-,R-}
  25.  
  26. PROGRAM DRVDEMO;
  27.  
  28. USES DOS, CRT, DRIVExx;
  29.  
  30. function cursorline : byte;
  31. var regs : registers;
  32. begin
  33.   regs.ax := $0F00;  {puts display page in regs.bh, necessary for next call}
  34.   Intr($10,regs);
  35.   regs.ax := $0300;
  36.   Intr($10,regs);
  37.   cursorline := regs.dh + 1;
  38. end;
  39.  
  40.  
  41. var index : char;
  42.     X     : longint;
  43.     DP    : fakeDPB;
  44.  
  45. {******************************************************************************}
  46. { ALWAYS CHECK THE GLOBAL ERROR VARIABLE 'DriveError' AT THE BEGINNING OF ANY  }
  47. { PROGRAM THAT USES THE DRIVExx UNIT, AND AGAIN AFTER EACH CALL TO             }
  48. { 'UpdateDrives' DURING PROGRAM EXECUTION!                                     }
  49. {                                                                              }
  50. { IF DriveError IS NON-ZERO, YOU MAY CALL THE PROCEDURE ShowDriveError to HELP }
  51. { INTERPRET THE ERROR, OR YOU MAY HANDLE THE SITUATION ANY WAY YOU LIKE.       }
  52. { A NON-ZERO DriveError DOES NOT MEAN A FATAL ERROR, JUST THAT YOU WON'T BE    }
  53. { ABLE TO DEPEND ON ANY INFORMATION YOU GET FROM ANY DRIVExx UNIT FUNCTION TO  }
  54. { BE CORRECT OR ACCURATE.                                                      }
  55. {                                                                              }
  56. { THERE ARE ONLY THREE TYPES OF ERRORS THAT WILL RESULT IN IMMEDIATE EXIT FROM }
  57. { UpdateDrives: WRONG DOS VERSION (OR OS/2), FAILURE TO FIND THE ADDRESS OF    }
  58. { THE LIST-OF-LISTS, AND NOT ENOUGH MEMORY TO CREATE THE VARIABLE DRIVES^.     }
  59. { ALL OF THESE ERRORS WILL RESULT IN ALL BOOLEANS SET TO FALSE AND ALL STRINGS }
  60. { SET TO NULL, BECAUSE THEY MAKE IT IMPOSSIBLE TO CONTINUE PROCESSING.         }
  61. {******************************************************************************}
  62.  
  63. BEGIN
  64.  
  65. clrscr;
  66.  
  67. if DriveError <> 0 then ShowDriveError; 
  68.  
  69. textcolor(white);
  70. writeln('DRVDEMO - DRIVExx Unit Demo Program, Copyright (C) 1991 by NativSoft Computing');
  71. textcolor(lightgray);
  72. window(1,2,80,25);
  73. writeln;
  74.  
  75. write(  'Operating System..............................: ');
  76. if DRDOS then write('DR DOS') else write('MS DOS');
  77. writeln(' version ',DOSVER:4:2);
  78. writeln('BIOS Date.....................................: ',BiosDateString);
  79. write(  'Processor Type................................: ');
  80. case ProcessorType of
  81.   1 : writeln('8088/8086');
  82.   2 : writeln('80286');
  83.   3 : writeln('80386');
  84.  -3 : writeln('80386SX');
  85.   4 : writeln('80486');
  86.   else writeln('Unknown (',ProcessorType,')');
  87. end; {case}
  88.  
  89. writeln;
  90. writeln('Valid Logical Drives..........................: ',alllogicaldrives);
  91. if DevDrvrChainValid then
  92. writeln('Bootable Drives...............................: ',bootabledrives);
  93. writeln('Number of BIOS-driven Internal Floppies.......: ',Internalfloppies);
  94. writeln('Valid Floppy Drives...........................: ',floppies);
  95. writeln('Valid Hard Disk Partitions....................: ',hards);
  96. writeln('Current default drive and path................: ',CurrentDir(defaultdrive));
  97. writeln;
  98. gotoxy(1,24);
  99. textcolor(white);
  100. write('Press ENTER to see individual drive characteristics ...');
  101. textcolor(lightgray);
  102. readln;
  103.  
  104.  
  105. clrscr;
  106. for index := 'A' to 'Z' do
  107. begin
  108.   if cursorline >= 21 then
  109.   begin
  110.     gotoxy(1,24);
  111.     write('==> Press ENTER to continue ');
  112.     readln;
  113.     clrscr;
  114.     writeln;
  115.   end;
  116.  
  117.   if DrivExists(index) then
  118.   begin
  119.     writeln;
  120.     writeln(index,':');
  121.     if DriveisNormal(index) then
  122.     begin
  123.       write('normal:');
  124.       if DriveisRemovable(index) then
  125.         begin
  126.           write(' removable');
  127.           case RemovableDrivetype(index) of
  128.           -3,-2,-1 :  write(', Drivetype error ',RemovableDrivetype(index));
  129.            1 :  write(', 5.25" DD');
  130.            2 :  write(', 5.25" HD');
  131.            3 :  write(', 3.5" DD');
  132.            4 :  write(', 3.5" HD');
  133.            5 :  write(', 3.5" QD');
  134.            6 :  write(', Tape');
  135.            7 :  write(', Bernoulli');
  136.            else write(', type = ?');
  137.           end; {case}
  138.           if ChangeLineSupported(index) then
  139.           begin
  140.              if DiskWasChanged(index) then write(', changed')
  141.              else write(', not changed');
  142.           end;
  143.         end
  144.       else
  145.         begin
  146.           if DriveisHard(index) then write(' hard');
  147.           if DriveisRAMDisk(index) then write(' RAMDisk');
  148.           if DriveisOtherfixed(index) then write(' unknown fixed');
  149.         end;
  150.       {can't use LONGINT variables as selectors in case statements, so we
  151.        must handle DriveSize in a less than elegant way}
  152.       X := DriveSize(index);
  153.       if (X = -1) then write(', size = error')
  154.       else
  155.       if (X = 0) then write(', size = ?')
  156.       else
  157.       write(', size = ',X);
  158.     end
  159.     else
  160.     begin
  161.       write('abnormal:');
  162.       if DriveisPhantom(index) then
  163.          write(' phantom, mapped to ',DriveMappedTo(index),':');
  164.       if DriveisNONDOS(index) then write(' NON-DOS');
  165.       if DriveisAliased(index) then
  166.       begin
  167.         if DRDOS then write(' aliased')
  168.           { DRDOS reports SUBST when *either* ASSIGN or SUBST is used.  Since
  169.             we cannot verify that NETWORK and IFS will be reported correctly
  170.             under DRDOS, we recommend that the generic "aliased" be used to
  171.             classify ALL of these situations below when running under that OS }
  172.         else
  173.         begin
  174.           if DriveisJoined(index) then write(' joined');
  175.           if DriveisSubsted(index) then write(' substituted');
  176.           if DriveisAssigned(index) then write(' assigned');
  177.           if DriveisNetwork(index) then write(' network');
  178.           if DriveisIFS(index) then write(' IFS');
  179.         end;
  180.       end;
  181.     end;
  182.  
  183.     {the following apply to all drives, normal or abnormal}
  184.  
  185.     if DevDrvrChainValid then
  186.     begin
  187.        if DriveisDeviceDriven(index) then write(', device driven');
  188.        if DriveisSwapped(index) then write(', swapped');
  189.     end;
  190.     writeln;
  191.     writeln('Logged Directory is ',CurrentDir(index));
  192.   end;
  193. end; {for index := 'A' to 'Z' do}
  194.  
  195.  
  196. writeln;
  197. writeln;
  198. write('Enter a drive letter to demonstrate function GETDPB ');
  199. readln(index);
  200. index := upcase(index);
  201. if pos(index, AllLogicalDrives) = 0 then halt;
  202. clrscr;
  203.  
  204. if GETDPB(index,DP,false) then {FALSE means don't hit the disk}
  205. begin
  206. writeln;
  207. writeln('Drive ',index,': DPB data in memory');
  208. writeln;
  209. with DP do 
  210. begin
  211.  writeln('Unit number within device driver : ',ddunitnum);
  212.  writeln('                Bytes per Sector : ',bytespersex);
  213.  writeln('             Sectors per Cluster : ',sexperclust);
  214.  writeln('                  Number of FATs : ',numFATS);
  215.  writeln('Number of root directory entries : ',RootdirEnts);
  216.  writeln('       First data sector on disk : ',FirstDataSec);
  217.  writeln(' Number of data clusters on disk : ',numclusts);
  218.  writeln('                 Sectors per FAT : ',sexperFAT);
  219.  writeln('      Sectors per root directory : ',RootdirSex);
  220.  writeln('           Media descriptor byte : ',mediabyte);
  221.  write  ('                     Access flag : ',accessflag);
  222.    if accessflag <> 0 then writeln('  (NOT ACCESSED SINCE BOOTUP)')
  223.                       else writeln;
  224. end;
  225. end;
  226.  
  227. writeln;
  228. writeln;
  229. write('Press ENTER to get *NEW* DPB data');
  230. readln;
  231. clrscr;
  232.  
  233. if GETDPB(index,DP,true) then {TRUE means hit the disk}
  234. begin
  235. writeln;
  236. writeln('Drive ',index,': DPB data from direct disk access');
  237. writeln;
  238. with DP do 
  239. begin
  240.  writeln('Unit number within device driver : ',ddunitnum);
  241.  writeln('                Bytes per Sector : ',bytespersex);
  242.  writeln('             Sectors per Cluster : ',sexperclust);
  243.  writeln('                  Number of FATs : ',numFATS);
  244.  writeln('Number of root directory entries : ',RootdirEnts);
  245.  writeln('       First data sector on disk : ',FirstDataSec);
  246.  writeln(' Number of data clusters on disk : ',numclusts);
  247.  writeln('                 Sectors per FAT : ',sexperFAT);
  248.  writeln('      Sectors per root directory : ',RootdirSex);
  249.  writeln('           Media descriptor byte : ',mediabyte);
  250.  writeln('                     Access flag : ',accessflag);
  251. end;
  252. end
  253. else
  254. begin
  255. writeln;
  256. writeln('Drive ',index,': probably not ready');
  257. end;
  258.  
  259. writeln;
  260. writeln;
  261. write('Press ENTER to quit demo');
  262. readln;
  263. clrscr;
  264.  
  265. END.
  266.